home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / SCHEME / GNU / SCM4E1 / !Scm / slib / test < prev    next >
Text File  |  1992-02-28  |  970b  |  42 lines
  1. ;;;; "test.scm", routines for testing.
  2. ;;; Copyright (C) 1991 Aubrey Jaffer.
  3.  
  4. (define cur-section '())
  5.  
  6. (define errs '())
  7.  
  8. (define SECTION (lambda args
  9.           (display "SECTION") (write args) (newline)
  10.           (set! cur-section args) #t))
  11.  
  12. (define record-error
  13.   (lambda (e) (set! errs (cons (list cur-section e) errs))))
  14.  
  15. (define test
  16.   (lambda (expect fun . args)
  17.     (write (cons fun args))
  18.     (display "  ==> ")
  19.     ((lambda (res)
  20.       (write res)
  21.       (newline)
  22.       (cond ((not (equal? expect res))
  23.          (record-error (list res expect (cons fun args)))
  24.          (display " BUT EXPECTED ")
  25.          (write expect)
  26.          (newline)
  27.          #f)
  28.         (else #t)))
  29.      (if (procedure? fun) (apply fun args) (car args)))))
  30.  
  31. (define (report-errs)
  32.   (newline)
  33.   (if (null? errs) (display "Passed all tests")
  34.       (begin
  35.     (display "errors were:")
  36.     (newline)
  37.     (display "(SECTION (got expected (call)))")
  38.     (newline)
  39.     (for-each (lambda (l) (write l) (newline))
  40.           errs)))
  41.   (newline))
  42.